# comun self hosted implementation: interpreter library
# module prefix: i
#
# This module implements the comun BC interpreter.
#
# Before including this library, define the following:
#
# - CMN_iMEM_SIZE: Func returning a const, size of CMN_iMem in cells, in TE 32.
# - CMN_iMem:      Ptr to mem in TE 32 that will be used by the interp, must
#                  point to at least CMN_iMEM_SIZE free cells.
# - CMN_iIn        Func that will be called to perform comun input, after being
#                  called it has to leave exactly one input val on ST (in TE 0).
#                  Returning -1 will be interpreted as end of input.
# - CMN_iOut       Func that will be called to perform comun output, it has to
#                  pop one ST item (in TE 0).
# - CMN_iGetArgs   Func that will be called on encountering the INI instr, it
#                  has to push (in TE 0) N (even 0) zero terminated strs
#                  followed by val N.
# - CMN_iCallExt   Func that will be called when BC calls external func N. This
#                  func will get N on TE 0 stack, the val has to be popped.
#
# The following are details concerning internal working of the interp.
#
# Cell bit width of TE 0 is set to 32.
#
# For simplicity interp mostly works in TE 32, using CMN_iMem. The structure of
# this mem is following:
#
#   ptrTable0 ptrTable1 ptrTable2 ptrTable3 callStack stackCell0 stackCell1 ...
#
# ptrTableN is PT of environment N, its total size depends on and is allocated
# based on BC initial analysis, index 0 is ptr 0, index 1 is first user ptr,
# index 2 is second user pointer etc.
#
# callStack is mem used for returning from called funcs, its size in cells is
# set inside the interp initialization func.
#
# stackCell is a cell of the simulated computation stack, each cell here holds
# one val for each TE that is used, the size and structure of this cell depends
# on BC initial analysis and is set as follows depending on which TEs are used
# by the BC:
#
# - only 1 TE used: Cell's size is 1, holding as many of the environment's cells
#   as possible, e.g. if TE 0 is used, each cell holds one val {0}, if TE 1 is
#   used each cell holds 4 (8 bit) vals {1,1,1,1} etc.
# - 3 or 4 type envs used: Size of each cell is 4, each subcell holds vals of
#   respective TE as follows: {0} {3} {2,2} {1,1,1,1}
# - 2 type envs used: Size of cell is 2, first subcell holds the val of wider
#   TE (TE 0 is before type eng. 3), each subcell holds as many vals as
#   possible, e.g. if type env 3 and 1 are used, cell will be of format:
#   {3} {1,1,1,1}

~"cmn_general.cmn"
~"cmn_bytecode_extra.cmn"

~CMN_iState             # interp state
~_CMN_iInputEnded

~32
  ~_CMN_iStack:0        # start of the stack within CMN_iMem
  ~_CMN_iCallStack:0    # start of the call stack inside CMN_iMem
  ~_CMN_iCallStackTop:0 
  ~_CMN_iMemEnd:0       # last cell of CMN_iMem
  ~_CMN_iCellSizeShift  # says bit shift associated with stack cell size
  ~_CMN_iOffsets:3      # holds helper offsets for type envs 1, 2 and 3 (offsets
                        # for TE 0 are always 0), each cell here holds subcell
                        # offset within stack cell in lower 16 bits and PT
                        # offset in higher 16 bits
  ~_CMN_iPushValue      # val to be pushed
  ~_CMN_iJumpAddr       # addr to jump to, -1 means none
~0

~_CMN_iPopPush          # lowest bit says if a val should be pushed, remaining
                        # bits encode the num of vals to be potentially popped
# interp states:
CMN_iSTATE_RUNNING:    0 . # still running
CMN_iSTATE_DONE:       1 . # finished running program
CMN_iSTATE_ERROR:      2 . # further unspecified interp error
CMN_iSTATE_ERROR_MEM:  3 . # accessing memory outside bounds
CMN_iSTATE_ERROR_CALL: 4 . # call stack over/underflow
CMN_iSTATE_ERROR_OP:   4 . # operation error (zero div. etc.)
CMN_iSTATE_ERROR_BC:   5 . # malformed BC error

# arg: te 3PtrI
# ret: 3addr
# Converts ptr index as encoded in an instruction to a mem addr.
_CMN_iPtrIToAddr:
  0 # here table index will go
  ~32
    0

    $1 15 > ?
      >< 15 -
    .

    >0
    CMN_iPtrTableSeek

    $_CMN_g3P1 >< -
  ~0
.

# arg: te recordIndex
# Sets _CMN_g3P1 to the cell of requested PT record, doesn't check arg validity.
CMN_iPtrTableSeek:
  ~32 0 ~0 >32
  ~32 0 ~0 >32
  ~32
    ?' # for TE 0 offset will also be 0, so we'll just do nothing
      $_CMN_iOffsets>_CMN_g3P1
      --
      $+_CMN_g3P1
      $_CMN_g3P1 16 |>
    .

    $CMN_iMem>_CMN_g3P1
    +
    $+_CMN_g3P1
  ~0
.

# arg: 3te
# ret: 3shift
# Computes a val (3shift) that's a bit shift representing how many subcells of
# TE 3typeEnv fit into one cell in TE 32., (i.e. e.g. 1 => one cell in TE 32 can
# hold 2^1 subcells).
_CMN_iTypeEnvToCellShift: ~32 $0 2 = >< 1 = 1 |< | ~0 .

# arg: 3te
# ret: 3binMask 3maskSize
# Similar to _CMN_iTypeEnvToCellShift but returns two vals: binary mask for the
# cell and num of 1 bits in it.
_CMN_iTypeEnvToCellMask:
  ~32
    $0 0 = $1 3 = | 5 |< $1 1 = 3 |< | >< 2 = 4 |< | # mask size
    +xffffffff 32 $2 - |> ><
  ~0
.

# arg: 3addr 3te
# ret: 3subAddr
# Seeks _CMN_g3P1 to mem cell that holds requested emulated stack cell. the
# returned 3subAddr is the remaining modulo subaddr within the seeked cell. The
# func doesn't check for stack boundaries.
_CMN_iStackSeek:
  ~32
    $0 $:_CMN_g3V1

    _CMN_iTypeEnvToCellShift 

    $1 $1 $0 2 = | & >< $<0 >< $>0 # subcell modulo addr, store it down

    |>
    $_CMN_iCellSizeShift |<

    $_CMN_g3V1 ?' # get cell offset within block
      --
      $_CMN_iOffsets>_CMN_g3P1
      $+_CMN_g3P1
      $_CMN_g3P1
      +xffff &
    .

    +
    $_CMN_iStack>_CMN_g3P1
    $+_CMN_g3P1
  ~0
.

# ret: 3bool
# Checks if _CMN_g3P1 is within bounds of emulated stack.
_CMN_iCheckStackBounds:
  ~32 $_CMN_iStack=_CMN_g3P1 1 != $_CMN_iMemEnd=_CMN_g3P1 2 != & ~0
.

# arg: 3val 3te 3addr
# Sets cell in given TE of the interp's emulated stack to given val. If addr is
# out of bounds if accessed, args are consumed and interp state is set to error.
CMN_iStackSet:
  ~32
    $1 # keep the val at $1 for later use
    _CMN_iStackSeek

    _CMN_iCheckStackBounds ?          # stack:
      ><                              # val, subAddr, typeEnv
      _CMN_iTypeEnvToCellMask         # val, subAddr, mask, maskSize
      $<0 >< $<0 & $>0 $>0 $>0 *      # val&mask, mask, subAddr*maskSize
      |< $>0 >< $<0 |< $_CMN_g3P1 $>0 # val&mask<<, subCell, mask<<
      ! & |                           # (val&mask<<)|(subCell&!mask<<)

      $:_CMN_g3P1
    ;
      ^ ^ ^ # 3val 3te 3ret_from_stackSeek
      ~0 CMN_iSTATE_ERROR_MEM $:CMN_iState ~32
    .
  ~0
.

# arg: te ptrIndex 3shiftSigned
# Adds given signed val to given ptr in PT.
CMN_iPointerShift: CMN_iPtrTableSeek ~32 $_CMN_g3P1 + $:_CMN_g3P1 ~0 .

# arg: 3te 3addr
# ret: 3val
# Same as CMN_iStackSet but retrieves val instead of setting it, val 0 is
# returned in case of error (args will be consumed in either case).
CMN_iStackGet:
  ~32
    $1 _CMN_iStackSeek

    _CMN_iCheckStackBounds ?  # stack:
      ><                      # subAddr, typeEnv
      _CMN_iTypeEnvToCellMask # subAddr, mask, maskSize
      $<0 >< $>0 *            # mask, subAddr*maskSize
      $_CMN_g3P1 >< |> &      # subCell>>&mask
    ;
      ^ 0
    .
  ~0
.

# arg: te 3val
# Pushes given val onto emulated stack.
CMN_iPush:
  ~32 0 ~0
  $0 >32

  0 CMN_iPtrTableSeek

  ~32
    $_CMN_g3P1
    ++
    $0 $:_CMN_g3P1
    CMN_iStackSet
  ~0
.

# arg: te n
# ret: 3val
CMN_iGetStackTopMinusN:
  ~32 0 ~0 >32 ~32 0 ~0 $0 >32
  ~32 >< ~0

  0 CMN_iPtrTableSeek

  ~32
    $_CMN_g3P1 >< - CMN_iStackGet
  ~0
.

# arg: te
# ret: 3val
CMN_iGetStackTop: 0 CMN_iGetStackTopMinusN .

# arg: te
# ret: 3valY 3valX
CMN_iGetStackXY:
  ~32 0 ~0 $0 >32

  0 CMN_iPtrTableSeek
  ~32
    $_CMN_g3P1
    $1 $1 CMN_iStackGet
    >< $<0 >< $>0 -- CMN_iStackGet
    ><
  ~0
.

# arg: callStackSize
# Initializes interp for running BC loaded in CMN_bBytecode, i.e. the BC must be
# present in the mem when this is called, preliminary analysis of it will be
# done by this func., callStackSize is size of call stack in cells that will be
# allocated inside CMN_iMem and should be kept reasonably low to leave space for
# PTs and emulated stack.
CMN_iInit:
  CMN_iSTATE_RUNNING $:CMN_iState
  0 $:_CMN_iInputEnded 

  CMN_eAnalyze

  ~32 0 ~0 ^ >32
  ~32 0 ~0 ^ >32
  ~32 0 ~0 ^ >32
  ~32 0 ~0 ^ >32

  # now callStackSize is still on the stack for later...
  ~32
    # compute a val that says which type envs are used
    $0 0 != 3 |<
    $2 0 != 2 |< |
    $3 0 != 1 |< |
    $4 0 != |

    $:_CMN_g3V1 # store the val here for now

    # set stack start:
    $CMN_iMem>_CMN_iCallStack
    $3 $3 $3 $3 + + +

    $+_CMN_iCallStack
    $_CMN_iCallStack>_CMN_iCallStackTop

    0 # here we'll move 0callStackSize
    ~0 >32 ~32
    $_CMN_iCallStack>_CMN_iStack
    $+_CMN_iStack

    # set PT offsets:
    $0 $:_CMN_iOffsets
    $>_CMN_iOffsets
    +
    $0 $:_CMN_iOffsets
    $>_CMN_iOffsets
    +
    $:_CMN_iOffsets
    ^
    # now go back and compute the cell offsets

    $_CMN_g3V1 +b1001 = ? 1 ; $_CMN_g3V1 +b0111 >= 3 * .
    $_CMN_iOffsets 16 |< |
    $:_CMN_iOffsets
    $<_CMN_iOffsets

    $_CMN_g3V1 $0 +b0011 = >< +b1010 = | ? 1 ; $_CMN_g3V1 +b0111 >= 2 * .
    $_CMN_iOffsets 16 |< |
    $:_CMN_iOffsets
    $<_CMN_iOffsets

    $_CMN_g3V1 +b0101 >=
    $_CMN_iOffsets 16 |< |
    $:_CMN_iOffsets

    # cell size shift
    $_CMN_g3V1 +b0101 & $_CMN_g3V1 1 |> +b0101 & +
    $0 +b0011 & >< 2 |> +
    -- $0 3 = -

    $:_CMN_iCellSizeShift

    # zero the whole interp mem:
    $CMN_iMem>_CMN_g3P1

    CMN_iMEM_SIZE @'
      0 $:_CMN_g3P1 $>_CMN_g3P1
      --
    .
    ^

    # set mem end ptr:
    $CMN_iMem>_CMN_iMemEnd
    CMN_iMEM_SIZE $+_CMN_iMemEnd
  
    0 CMN_bCurrentInstrSetAddr
  ~0
.

# Performs another interp step (executes the next instruction). This func may
# call the user defined I/O funcs (even several times). If interp state is not
# OK (e.g. error or end), nothing happens. Nothing is returned, status is kept
# in CMN_iState.
CMN_iStep:
  $CMN_iState CMN_iSTATE_RUNNING = ?
    ~32 -1 $:_CMN_iJumpAddr ~0

    CMN_bCurrentInstrGet CMN_bInstrOpcode

    0 $:_CMN_iPopPush

    $0 4 |> 2 < ?
      # special instruction

      $0 +b00010000 & ?
        $0 +b00001000 & ?
          # 00011xxx

          $0 CMN_bOPCODE_CON = ?
            # COC does pop/push in different order, so we handle the push here
            # and only let the later code only handle the pop

            CMN_bCurrentInstrTypeEnv
            ~32 CMN_bCurrentInstrGetConst32 ~0
            CMN_iPush

            +b10 $:_CMN_iPopPush
          ;
          $0 CMN_bOPCODE_POP = ?
            CMN_bCurrentInstrGetConst ++ 1 |< $:_CMN_iPopPush
          ;
          $0 CMN_bOPCODE_SWP = ?
            CMN_bCurrentInstrTypeEnv
            $0 $0 # 3 vals: for following func, then for two pushes later
            CMN_iGetStackXY

            CMN_bCurrentInstrGet CMN_bInstrWontPop !! ?
              CMN_bCurrentInstrTypeEnv
              0 ~32 -2 ~0 CMN_iPointerShift
            .

            CMN_iPush
            CMN_iPush
          ;
          $0 CMN_bOPCODE_CND = ?
            CMN_bCurrentInstrTypeEnv
            $0 2 CMN_iGetStackTopMinusN
            CMN_iGetStackXY
            ~32 ??  $0 >0       $:_CMN_iPushValue ~0
            +b111 $:_CMN_iPopPush
          ;
          $0 CMN_bOPCODE_TRA = ?
            CMN_bCurrentInstrTypeEnv
            CMN_iGetStackTop
            CMN_bCurrentInstrGetConst
            ~32 0 ~0 $0 >32
            0 CMN_iPtrTableSeek
            ~32 $_CMN_g3P1 ~0
            CMN_iStackSet
            +b10 $:_CMN_iPopPush
          ;
          $0 CMN_bOPCODE_OUT = ?
            CMN_bCurrentInstrTypeEnv
            CMN_iGetStackTop
            0 ~32 >0 ~0
            CMN_iOut
            +b10 $:_CMN_iPopPush
          . . . . . .
        ;
          # 00010xxx

          $0 CMN_bOPCODE_MGE = ?
            CMN_bCurrentInstrTypeEnv
            ~32 0 ~0 $0 >32
            CMN_bCurrentInstrGetConst32
            _CMN_iPtrIToAddr
            CMN_iStackGet
            ~32 $:_CMN_iPushValue ~0
            +b01 $:_CMN_iPopPush
          ;
          $0 CMN_bOPCODE_MEX = ?
            CMN_bCurrentInstrTypeEnv
            $0 CMN_iGetStackTop
            ~32 0 ~0 $0 >32
            CMN_bCurrentInstrGetConst32
            _CMN_iPtrIToAddr
            CMN_iStackSet
            +b10 $:_CMN_iPopPush
          ;
          $0 CMN_bOPCODE_PAC = ?
            CMN_bCurrentInstrTypeEnv
            0 # here ptr index will go

            ~32
              CMN_bCurrentInstrGetConsts32
              CMN_ePtrIToPtrTableI >0

              $0 +b1000 & ? # 4bit two's compl., sign extend if needed
                +xfffffff0 |
              .

              CMN_iPointerShift
            ~0
          ;
          $0 CMN_bOPCODE_PCO = ?
            CMN_bCurrentInstrTypeEnv
            CMN_bCurrentInstrGetConsts32
            0 ~32 CMN_ePtrIToPtrTableI >0 ~0
            $1 0 ~32 CMN_ePtrIToPtrTableI >0 ~0
            CMN_iPtrTableSeek
            ~32 $_CMN_g3P1 ~0
            CMN_iPtrTableSeek
            ~32 $:_CMN_g3P1 ~0
          ;
          $0 CMN_bOPCODE_PUX = ?
            CMN_bCurrentInstrTypeEnv $0 CMN_iGetStackTop
            0 ~32 >0 ~0 CMN_iGetStackTopMinusN
            ~32 $:_CMN_iPushValue ~0
            +b11 $:_CMN_iPopPush
          ;
          $0 CMN_bOPCODE_PAX = ?
            CMN_bCurrentInstrTypeEnv
            $0 CMN_iGetStackTop

            $0 1 = 0 ~32 $0 +x80 & >0 ~0 && ?
              ~32 +xffffff00 | ~0
            ;
            $0 2 = 0 ~32 $0 +x00008000 & >0 ~0 && ?
              ~32 +xffff0000 | ~0
            . .

            0 # for PT index
            ~32
              CMN_bCurrentInstrGetConst32
              CMN_ePtrIToPtrTableI
              >0
            ~0

            $0 ?
              +b10 $:_CMN_iPopPush # don't pop if we're shifting ST
            .

            CMN_iPointerShift
          ;
          $0 CMN_bOPCODE_PCM = ?
            CMN_bCurrentInstrTypeEnv $0
            CMN_bCurrentInstrGetConsts32

            ~32
              >< _CMN_iPtrIToAddr >< _CMN_iPtrIToAddr
              - $0 0 << 1 |< >< 0 >> | $:_CMN_iPushValue
            ~0

            +b01 $:_CMN_iPopPush
          ;
          # CMN_bOPCODE_PSC
            CMN_bCurrentInstrTypeEnv 0

            ~32
              CMN_bCurrentInstrGetConsts32
              CMN_ePtrIToPtrTableI
              >0
              CMN_iPtrTableSeek
              $:_CMN_g3P1
            ~0
          . . . . . . .
        .
      ;
        $0 +b00001000 & ?
          # 00001xxx

          $0 CMN_bOPCODE_RET = ?
            ~32
              $<_CMN_iCallStackTop # TODO: check bounds (or just trust BC?)
              $_CMN_iCallStackTop
              ++ $:_CMN_iJumpAddr
            ~0
          ;
          $0 CMN_bOPCODE_CAE = ?
            CMN_bCurrentInstrGetConst
            CMN_iCallExt
          ;
          $0 CMN_bOPCODE_INI = ?
            $0>_CMN_gP1
            CMN_iGetArgs 
            0 $:_CMN_gV1

            @@
              $_CMN_gV1 ++ $:_CMN_gV1
              $>_CMN_gP1

              $_CMN_gP1=0 1 = ?
                !@
              .
            
              ~32 0 ~0 $_CMN_gP1 >32 0
              CMN_iPush 
            .

            $_CMN_gV1 -1 * $+0
          ;
            # CMN_bOPCODE_JIA, CMN_bOPCODE_JNA, CMN_bOPCODE_JMA
            $0 CMN_bOPCODE_JMA = # val that says whether to jump or not

            $0 !! ?
              CMN_bCurrentInstrTypeEnv CMN_iGetStackTop
              $1 CMN_bOPCODE_JNA = ? ~32 !! ~0 .
              ~32 >0 ~0
              +b10 $:_CMN_iPopPush
            .

            ? # do jump?
              ~32 CMN_bCurrentInstrGetConst32 $:_CMN_iJumpAddr ~0
            .
          . . .
        ;
          # 00000xxx

          $0 CMN_bOPCODE_CAL = ?
            ~32
              CMN_bCurrentInstrGetConst32
              $CMN_bCurrentInstrAddr $:_CMN_iCallStackTop
              $>_CMN_iCallStackTop
              $:_CMN_iJumpAddr

              # check call stack overflow:
              $_CMN_iCallStackTop=_CMN_iStack 2 != ?
                ~0 CMN_iSTATE_ERROR_CALL $:CMN_iState ~32
              .
            ~0

          ; $0 CMN_bOPCODE_END = ?
            CMN_iSTATE_DONE $:CMN_iState
          . .
        .
      .
    ;
      # typical stack instrs

      $0 CMN_bOPCODE_ADR < ?
        # instrs that belong to subgroups

        $0 +b00000011 & # get the mode, push instr args accordingly to TE 32

        $0 CMN_bMODE21 = ?
          CMN_bCurrentInstrTypeEnv CMN_iGetStackXY
          +b0101 $:_CMN_iPopPush
        ;
        $0 CMN_bMODE1C1 = ?
          CMN_bCurrentInstrTypeEnv CMN_iGetStackTop
          CMN_bCurrentInstrGetConst32 
          +b0011 $:_CMN_iPopPush
        ;
        $0 CMN_bMODE11 = ?
          ~32 0 ~0
          CMN_bCurrentInstrTypeEnv CMN_iGetStackTop
          +b0011 $:_CMN_iPopPush
        ;
        # CMN_bMODE01
          ~32 0 0 ~0
          +b0010 $:_CMN_iPopPush
        . . .

        ^ # opcode mode

        $0 +b11111100 & # extract the group
        $0 +b01100000 & # take two bits by which we accelerate the search
        ><

        $1 +b00100000 = ?
          ~32 $1 $1 ~0

          $0 CMN_bOPCODE_ADX = ? ~32 + ~0 ;
          $0 CMN_bOPCODE_SUX = ? ~32 - ~0 ;
          $0 CMN_bOPCODE_MUX = ? ~32 * ~0
          ;
            # CMN_bOPCODE_DIX, CMN_bOPCODE_DSX, CMN_bOPCODE_MOX, CMN_bOPCODE_MSX

            ~32 $0 0 = ? ~0
              # division by zero
              CMN_iSTATE_ERROR_OP $:CMN_iState
              ~32 ^ ^ 0 ~0
            ;
              $0 CMN_bOPCODE_DIX = ? ~32 / ~0 ;
              $0 CMN_bOPCODE_MOX = ? ~32 % ~0 ;
              $0 CMN_bOPCODE_DSX = ?
                CMN_bCurrentInstrTypeEnv
                $0 1 = ?  ~8 0 ~32 >8 ~8 0 ~32 >8 0 ~8 >< // >32 ~0       ;
                $0 2 = ?  ~16 0 ~32 >16 ~16 0 ~32 >16 0 ~16 >< // >32 ~0  ;
                          ~32 // ~0 # 0 and 3
                . .
                ^
              ;
              # CMN_bOPCODE_MSX
                CMN_bCurrentInstrTypeEnv
                $0 1 = ?  ~8 0 ~32 >8 ~8 0 ~32 >8 0 ~8 >< %% >32 ~0       ;
                $0 2 = ?  ~16 0 ~32 >16 ~16 0 ~32 >16 0 ~16 >< %% >32 ~0  ;
                          ~32 %% ~0 # 0 and 3
                . .
                ^
              . . .
            .
          . . .
              
          ~32 $:_CMN_iPushValue ~0
        ;
        $1 +b01000000 = ?
          ~32 $1 $1 ~0

          $0 CMN_bOPCODE_GRX = ? ~32 >  ~0 ;
          $0 CMN_bOPCODE_GEX = ? ~32 >= ~0 ;
          $0 CMN_bOPCODE_SMX = ? ~32 <  ~0 ;
          $0 CMN_bOPCODE_SEX = ? ~32 <= ~0
          ;
            # signed comparisons

            $0 +b100 & 0 ~32 = >0 ~0 && ? # equality check and equal?
              ~32 1 ~0
            ;
              $0 CMN_bOPCODE_SSX = $0 CMN_bOPCODE_LSX = | ?
                ~32 >< ~0
              .

              ~32 $1 $1 ~0

              CMN_bCurrentInstrTypeEnv
             
              $0 1 = ? ~8  0 ~32 >8  ~8  0 ~32 >8  0 ~8  >< >> >32 ~0 ;
              $2 2 = ? ~16 0 ~32 >16 ~16 0 ~32 >16 0 ~16 >< >> >32 ~0 ;
                       ~32 >> ~0
              . .
              ^
            .
          . . . .

          ~32 $:_CMN_iPushValue ~0
        ;
        $1 +b01100000 = ?
          ~32 $1 $1 ~0
          $0 CMN_bOPCODE_EQX = ? ~32 =   ~0 ;
          $0 CMN_bOPCODE_NEX = ? ~32 !=  ~0 ;
          $0 CMN_bOPCODE_BAX = ? ~32 &   ~0 ;
          $0 CMN_bOPCODE_BOX = ? ~32 |   ~0 ;
          $0 CMN_bOPCODE_BXX = ? ~32 |!  ~0 ;
          $0 CMN_bOPCODE_LAX = ? ~32 &&  ~0 ;
          $0 CMN_bOPCODE_LOX = ? ~32 ||  ~0 ;
          # CMN_bOPCODE_LXX #    ~32 |!! ~0
          . . . . . . .
          ~32 $:_CMN_iPushValue ~0
        ;
        # +b00000000
          $0 CMN_bMODE11 | CMN_bOPCODE_BNO = ?
            ~32 $0 ! $:_CMN_iPushValue ~0
          ;
          $0 CMN_bOPCODE_SRX = ?  ~32 $1 $1 |> $:_CMN_iPushValue ~0  ;
          $0 CMN_bOPCODE_SLX = ?  ~32 $1 $1 |< $:_CMN_iPushValue ~0
          . . .
        . . .

        ^ ^ # group and search bits

        ~32 ^ ^ ~0 # instr args
      ;
        $0 CMN_bOPCODE_INP = ?
          CMN_iIn
          $0 -1 = $_CMN_iInputEnded || ?
            ^ ~32 0 ~0
            1 $:_CMN_iInputEnded
          ;
            ~32 0 ~0 >32
          .
            
          ~32 $:_CMN_iPushValue ~0
          +b01 $:_CMN_iPopPush
        ;
        $0 CMN_bOPCODE_INU = ?
          $_CMN_iInputEnded !! ~32 0 ~0 >32 ~32 $:_CMN_iPushValue ~0
          +b01 $:_CMN_iPopPush
        ;
        # CMN_bOPCODE_ADR
          +b01 $:_CMN_iPopPush
          CMN_bCurrentInstrTypeEnv 0 CMN_iPtrTableSeek
          ~32 $_CMN_g3P1 $:_CMN_iPushValue ~0
        . .
      .
    . # end of opcode analysis

    ^ # opcode

    $_CMN_iPopPush ?' # now handle pops and pushes
      # first recompute new ST:
      ~32
        0
        ~0 $_CMN_iPopPush >32 ~32

        $0 1 & >< 1 |>

        ~0 CMN_bCurrentInstrGet CMN_bInstrWontPop ? ~32
          ^
        ;
          -
        .

        CMN_bCurrentInstrTypeEnv
        ~0 0 ~32
        CMN_iPointerShift
      ~0

      # now write to ST:
      $_CMN_iPopPush 1 & ?
        ~32 $_CMN_iPushValue 0 ~0

        CMN_bCurrentInstrTypeEnv >32

        ~32
          $_CMN_g3P1
          CMN_iStackSet
        ~0
      .
    .
    ^

    ~32
      $_CMN_iJumpAddr -1 = ?
        CMN_bCurrentInstrShift
      ;
        $_CMN_iJumpAddr CMN_bCurrentInstrSetAddr
      .
    ~0
  .
.

# ret: 3a 3b 3c 3d ... n
# Pushes addrs on call stack (incl. current addr), along with their count (n).
CMN_iStackTrace:
  1
  ~32
    $CMN_bCurrentInstrAddr # current addr on top of stack
    $_CMN_iCallStackTop>_CMN_g3P1
    $<_CMN_g3P1

    @@
      $_CMN_g3P1=_CMN_iCallStack 2 = ?
        !@
      .

      $_CMN_g3P1
      ~0 ++ ~32
      $<_CMN_g3P1
    .
  ~0
.
